perm filename IO[CRE,BGB] blob sn#041546 filedate 1973-05-13 generic text, type C, neo UTF8
COMMENT ⊗   VALID 00017 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00003 00002	TITLE IO - INPUT OUTPUT SUBROUTINES - BGB - 16 APRIL 1973.
C00006 00003	SUBR(FILNUM)SERIAL.	SETUP FILE-SERIAL-NUMBER-NAME.
C00008 00004	SUBR(TVDSKI)SERIAL		INPUT TV PICTURE FROM DISK FILE.
C00010 00005	SUBR(TVPACK).		PACK TVBUF WITH PICTURE FROM SKY ARRAY.
C00013 00006	SUBR(TVDSKO)  		INPUT TV PICTURE FROM A DISK FILE.
C00015 00007	
C00016 00008	SUBR(TVXGP)		 VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
C00018 00009	GRAB THE DEVICE.
C00021 00010	SUBR(VICXGP)Q1,Q2	 VIDEO INTENSITY CONTOURS TO XGP.
C00023 00011	
C00024 00012	
C00027 00013	SUBR(CREOUT)		OUTPUT CONTOURS, REGION, EDGE FILE.
C00029 00014	SUBR(CREIN)	 CONTOUR,REGION,EDGE FILE FORMAT INPUT.
C00031 00015	TVIN4.		FOUR BIT TELEVISION INPUT.
C00033 00016	SUBR(TVIN6).		 SIX BIT TELEVISION INPUT.
C00036 00017	REALIN - REAL NUMBER INPUT FROM TTY.
C00038 ENDMK
C⊗;
TITLE IO - INPUT OUTPUT SUBROUTINES - BGB - 16 APRIL 1973.

	EXTERN REMAIN,BLKCNT,FTVHIS,FTVSIX
	EXTERN VCUT,TVBUF,HISTO,AVAIL,OLD44,FILM,FLGBGB
	EXTERN HEADER,HISTOG,CHR
	EXTERN DPYBUF,QBLK,DPYIMG
	EXTERN RELLOC,SHRINK,SKY

SUBR(GETFIL)------------------------------------------------------
BEGIN GETFIL;SETUP FILE SPEC FROM TTY LINE - BGB - 10 DEC 72.
	DZM FILNAM↔DZM EXTION↔DZM EXTION+1↔DZM PPPN
	OUTSTR[ASCIZ/	FILE = /]
	LAC 1,[POINT 6,FILNAM,-1]↔LACI 2,6
	INCHWL↔CAIN 15↔GO[INCHWL↔POP2J]↔AOSA(P)
L:	INCHWL↔CAIL"a"↔SUBI 40
	CAIN"."↔GO[LAC 1,[POINT 6,EXTION,-1]↔LACI 2,3↔GO L]
	CAIN"["↔GO[LAC 1,[POINT 6,PPPN,-1]  ↔LACI 2,3↔GO L]
	CAIN","↔GO[LAC 1,[POINT 6,PPPN,17]  ↔LACI 2,3↔GO L]
	CAIN"]"↔GO L
	CAIN 15↔GO EOL			;END OF THE LINE.
	CAIN 12↔GO EOL
	CAIG" "↔GO L	;IGNORE GARBAGE.
	SOJL 2,L↔SUBI 40↔IDPB 1↔GO L

EOL:	INCHWL
	CAR PPPN
	TRNN 77↔LSH -6↔TRNN 77↔LSH -6    ;RIGHT ADJUST PROJECT.
	DIP PPPN
	CDR PPPN
	TRNN 77↔LSH -6↔TRNN 77↔LSH -6    ;RIGHT ADJUST PROGRAMMER.
	DAP PPPN
	SKIPN 1,EXTION↔LAC 1,ARG2↔DAC 1,EXTION	;DEFAULT EXTENSION.
	SKIPN FLGBGB↔POP2J
	SKIPN 1,PPPN↔LAC 1,ARG1↔DAC 1,PPPN	;DEFAULT PROJECT.
	POP2J
BEND;12/10/72------------------------------------------------------

FILNAM:	0	;FILE NAME.
EXTION:	0	;EXTENSION.
	0
PPPN:	0	;PROJECT-PROGRAMMER & FILESIZE -WC SWAPPED.

SUBR(FILNUM)SERIAL.	;SETUP FILE-SERIAL-NUMBER-NAME.
BEGIN FILNUM;------------------------------------------------------
	EXTERN FNAME6
	LAC 10,FNAME6↔LAC 1,[POINT 6,10,-1]	;FILM NAME SIXBIT.
	LAC 0,1↔ILDB 2,1↔SKIPE 2↔GO .-3		;SCAN FOR 00.

;CONVERT SERIAL NUMBER TO SIXBIT DECIMAL NUMERAL.
	LACM 1,ARG1↔DAC 1,2↔DAC 1,3↔DAC 1,4↔DAC 1,5
	CAIL 1,=10000↔GO L5
	CAIL 1,=1000↔GO L4
	CAIL 1,=100↔GO L3
	CAIL 1,=10↔GO L2
		 ↔GO L1

L5:	IDIVI 1,=10000↔ADDI 1,20↔IDPB 1,0
L4:	IDIVI 2,=1000 ↔ADDI 2,20↔IDPB 2,0
L3:	IDIVI 3,=100  ↔ADDI 3,20↔IDPB 3,0
L2:	IDIVI 4,=10   ↔ADDI 4,20↔IDPB 4,0
L1:	               ADDI 5,20↔IDPB 5,0
	DAC 10,FILNAM

;TMP EXTENSION AND PPPN.
	LAC[SIXBIT/TMP/]↔DAC EXTION
	DZM EXTION+1
	DZM↔SKIPE FLGBGB↔LAC[SIXBIT/DATBGB/]↔DAC PPPN
	POP1J

BEND FILNUM; BGB 19 APRIL 1973 ------------------------------------
SUBR(TVDSKI)SERIAL		INPUT TV PICTURE FROM DISK FILE.

COMMENT/ Serial -1 asks user for file name. Serial ≥0 attempts
film image XXXX00.TMP input. TVDSKI returns TRUE -1 if image
found or FALSE 0 if image not found./

BEGIN TVDSKI;-----------------------------------------------------

	SKIPL 1,ARG1↔GO[CALL(FILNUM,1)↔GO L1]
L0:	CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])
FALSE:	GO[DZM 1↔POP1J]		;RETURN FALSE - NO PICTURE.
L1:	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	LOOKUP 1,FILNAM↔GO[SKIPGE ARG1↔GO L0↔GO FALSE]

	MOVS PPPN↔MOVMS			;GET FILE SIZE.
	CAIN 24400↔GO L2
	SUBI 200↔DACN
	DIP DUMP2+1
	IN 1,DUMP2↔JFCL			;NON-STANDARD SIZE.
	CALL(TVPACK)
	GO L4

L2:	IN 1,DUMP1↔JFCL			;216 x 288 STANDARD SIZE.
L4:	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,↔SETO 1,↔POP1J	;RETURN TRUE.

DUMP1:	IOWD 200,HEADER
	IOWD 24200,TVBUF↔0
DUMP2:	IOWD 200,HEADER
	IOWD 24200,SKY↔0

BEND TVDSKI; BGB 6 DECEMBER 1972 ---------------------------------
SUBR(TVPACK).		PACK TVBUF WITH PICTURE FROM SKY ARRAY.
COMMENT/ Take a non-standard size picture from the SKY array and pack
it into the TVBUF. TVPACK loops are for R ← 0 to 215 and for C ← 0 to
287; at each target pixel a check is made to see if there is a source
pixel to be moved./
BEGIN TVPACK;-----------------------------------------------------

	ACCUMULATORS{B,R1,C1,R2,C2,Q0,Q1,Q2}

;READ TV FILE HEADER & MAKE SURE THAT IT IS REASONIBLE.
	SETO↔CAME HEADER↔GO[OUTSTR[ASCIZ/	UNKNOWN, TV FILE FORMAT.
/]↔POP0J]
	LAC HEADER+1↔DAC BYTSIZ#
	LAC HEADER+2↔DAC WWIDTH#
	LAC HEADER+4↔SUB HEADER+3↔AOS↔DAC MROWS#↔LSH -1↔DAC HALFM#
	LAC HEADER+6↔SUB HEADER+5↔AOS↔DAC NCOLS#↔LSH -1↔DAC HALFN#

	LAC R2,HALFM↔SUBI R2,=108
	LAC Q0,R2↔IMUL Q0,WWIDTH
	ADDI Q0,SKY↔CDR 0,HEADER+7↔SUBI 0,200↔ADD Q0,0
	LAC Q2,[POINT 6,TVBUF,-1]
	DZM R1
L0:	DZM C1↔LAC C2,HALFN↔SUBI C2,=144
L1:	DZM B
	SKIPL R2↔CAML R2,MROWS↔GO L2
	SKIPL C2↔CAML C2,NCOLS↔GO L2
	TLNN Q0,-1↔CALL(L3)
	ILDB B,Q1
	LSH B,0
L2:	IDPB B,Q2
	AOS C2↔AOS C1↔CAIE C1,=288↔GO L1
	ADD Q0,WWIDTH↔LAC Q1,Q0
	AOS R2↔AOS R1↔CAIE R1,=216↔GO L0
	POP0J

;COMPUTE SOURCE COLUMN BYTE POINTER, ONCE PER PICTURE.
L3:	LAC 0,C2↔IDIV 0,BYTSIZ↔ADD Q0,0		;WORD.
	IMUL 1,BYTSIZ↔LACI 0,=36↔SUB 0,1	;P-BITS.
	LSH 0,6↔IOR 0,BYTSIZ↔ROT 0,-=12		;S-BITS.
	IOR Q0,0↔LAC Q1,Q0
	LACI 6↔SUB BYTSIZ↔DAP L2-1
	POP0J

BEND TVPACK; BGB 18 APRIL 1973 -----------------------------------
SUBR(TVDSKO)  		INPUT TV PICTURE FROM A DISK FILE.
BEGIN TVDSKO;-----------------------------------------------------

	CALL(GETFIL,[SIXBIT/TMP/],[SIXBIT/DATBGB/])↔POP0J
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	ENTER 1,FILNAM↔GO[OUTSTR[ASCIZ/	ENTER FAILED.
/]↔GO .+4]
	LAC[XWD HEADER,HEADER+1]↔DZM HEADER↔BLT HEADER+177
	LAC[XWD HEAD1,HEADER]↔BLT HEADER+7
	OUT 1,DUMARG↔JFCL
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,↔POP0J
HEAD1:	-1
	6	; BITS PER BYTE.
	=48	;WORDS PER LINE.
	=20	;FIRST AND LAST ROW.
	=235
	=28
	=315	;FIRST AND LAST COL.
	XWD -=10368,200
DUMARG:	IOWD 24400,HEADER↔0
BEND TVDSKO; BGB 6 DECEMBER 1973 ---------------------------------

SUBR(PLOTO)-------------------------------------------------------
BEGIN PLOTO;DISPLAY BUFFER TO DISK FILE - BGB 10 DEC 1972.
	CALL(GETFIL,[SIXBIT/PLT/],[0])↔POP0J
	LAC 1,DPYBUF↔LACN(1)1↔SUBI 2
	CDR 2,(1)↔DZM 1(2)
	MOVS↔LAPI -1(1)↔DAC DUMLST
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	ENTER 1,FILNAM↔GO .+4
	OUT 1,DUMLST↔JFCL
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,↔POP0J
DUMLST:	0↔0
BEND;12/10/72------------------------------------------------------
SUBR(TVXGP)		 VIDEO BUFFER TO XEROX GRAPHICS PRINTER.
BEGIN TVXGP;------------------------------------------------------
	ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
COMMENT/ One to sixteen expansion: (216*4=864) by (288*4=1152).
or 32 words per line. Buffer size (864 lines)*33+1= 28513 words./

;EXPAND CORE FOR XGP BUFFER & CLEAR THE BUFFER.
	LAC 44↔DAC SAV44#↔AOS↔DAC XBUF#↔ADDI =28513+10↔CORE↔GO L5
	CDR 1,XBUF↔DZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)

;PUT CONTROL WORDS IN THE 864 ROWS OF THE XGP IMAGE.
	LAC 1,XBUF
	SLACI %↔DAC(1)↔AOS 1		     ;CUT PAPER.
	SLACI =200⊗6↔DAC(1)↔AOS 1	     ;SPACE DOWN 100 LINES.
	LAC[1B11+=192B23+=32]↔LACI 2,=864    ;864 ROWS OF 32 WORDS.
	DAC(1)↔ADDI 1,=33↔SOJG 2,.-2	  
	LAC[5770B11]↔DAC(1)↔AOS 1	     ;SPACE AFTER PICTURE.
	SLACI %↔DAC(1)			     ;CUT PAPER.

;PACK VIDEO BYTES INTO XGP 4 BY 4 BIT ARRAYS.
	LAC P1,[POINT 6,TVBUF,-1]
	LAC P2,XBUF↔ADDI P2,3		;BUFFER POINTER.
	LACI I,=216
L1:	LACI J,=32
L2:	SETZB 0,1↔SETZB 2,3↔LACI K,=9
L3:	ILDB Q,P1↔TRZ Q,3↔ROTC 0,4↔ROTC 2,4
	IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
	IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
	SOJG K,L3
	DAC 0,=00(P2)↔DAC 1,=33(P2)
	DAC 2,=66(P2)↔DAC 3,=99(P2)
	AOS P2↔SOJG J,L2
	ADDI P2,=100↔SOJG I,L1

;GRAB THE DEVICE.
L4:	INIT 1,117
	SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔	POP0J]
	SETZ↔SEGNUM
	DAC SAVSEG#↔DETSEG
	LOCK

;SLACI -=28516
	LAP XBUF↔SOS↔	LIPI -=7130↔	DAC B1
	ADDI =7130↔	LIPI -=7128↔	DAC B2
	ADDI =7128↔	LIPI -=7128↔	DAC B3
	ADDI =7128↔	LIPI -=7130↔	DAC B4
LL5:
;DAC DUMARG
	OUT 1,B1↔OUTSTR[ASCIZ/	FIRE BUFFER 1 !/]↔CRLF
	OUT 1,B2↔OUTSTR[ASCIZ/	FIRE BUFFER 2 !/]↔CRLF
	OUT 1,B3↔OUTSTR[ASCIZ/	FIRE BUFFER 3 !/]↔CRLF
	OUT 1,B4↔OUTSTR[ASCIZ/	FIRE BUFFER 4 !/]↔CRLF
	UNLOCK
	RELEASE 1,


	LAC SAV44↔CORE
L5:	OUTSTR[ASCIZ/ XGP CORE UUO FAILED.
/]↔	CRLF↔LAC SAVSEG↔ATTSEG↔JFCL↔POP0J


;HALF TONE TABLE.
HTT:	6↔7↔7↔6↔	6↔6↔7↔6↔	6↔6↔6↔6↔	6↔6↔6↔6
	6↔6↔6↔4↔	4↔6↔6↔4↔	4↔6↔6↔4↔	4↔4↔6↔4
	4↔4↔4↔4↔	4↔4↔4↔4↔	0↔4↔4↔4↔	4↔4↔4↔0
	0↔4↔4↔0↔	0↔0↔4↔0↔	0↔0↔4↔0↔	0↔0↔0↔0
DUMARG:0↔0
B1:0↔0
B2:0↔0
B3:0↔0
B4:0↔0
BEND;1/19/73-------------------------------------------------------
SUBR(VICXGP)Q1,Q2	 VIDEO INTENSITY CONTOURS TO XGP.
BEGIN VICXGP;-----------------------------------------------------
	ACCUMULATORS{S2,S3,I,J,K,Q,P1,P2}
	EXTERN VSEG,HSEG,TVBUF,THRESH,PACXOR
;BIT POSITIONS OF THE ARGUMENTS Q1 & Q2 ENABLE INTENSITY CUTS.
	LAC 1,ARG2↔DAC 1,Q0#
	LAC 1,ARG1↔ANDCMI 1,377↔DAC 1,Q1#
	DZM CUT#
;CLEAR THE TMP AREA FOR VSEG-HSEG ACCUMULATION.
	LAC[XWD SKY,SKY+1]↔DZM SKY↔BLT SKY+=3500

;FIND AN INTENSITY CONTOUR ENABLE BIT.
LL0:	LAC 0,Q0↔LAC 1,Q1
LL1:	AOS 2,CUT↔LSHC 0,1↔JUMPL 0,LL2
	CAMN 0,1↔JUMPE 0,LL5↔GO LL1

;THRESHOLD THE TVBUF
LL2:	DAC 0,Q0↔DAC 1,Q1
	CALL(THRESH,CUT)
	CALL(PACXOR)
	LACI 1,=3457↔LAC VSEG(1)↔IORM SKY(1)↔SOJG 1,.-2
	GO LL0

LL5:	LAC[XWD SKY,VSEG]↔BLT VSEG+=3456

;PACK VSEG'S AND HSEG'S INTO THE TVBUF.
	LAC[XWD LL3,2]↔BLT 14↔GO 3
LL3:	=62208		;2
	ILDB 0,11	;3
	ILDB 1,12	;4	;GET HSEG BIT.
	 DPB 1,14	;5	;COMBINE THEM.
	IDPB 0,13	;6	;PACK THEM INTO TVBUF.
	SOJG 2,3	;7
	GO LL4		;10
	POINT 1,VSEG	;11
	POINT 1,HSEG	;12
	POINT 6,TVBUF	;13
	POINT 1,0,34	;14
LL4:

;EXPAND CORE FOR XGP BUFFER & CLEAR THE BUFFER.
	LAC 44↔DAC SAV44#↔AOS↔DAC XBUF#↔ADDI =28513+10↔CORE↔GO L5
	CDR 1,XBUF↔DZM(1)↔DIP 1,1↔AOS 1↔CDR 2,44↔BLT 1,(2)

;PUT CONTROL WORDS IN THE 864 ROWS OF THE XGP IMAGE.
	LAC 1,XBUF
	SLACI %↔DAC(1)↔AOS 1		     ;CUT PAPER.
	SLACI =200⊗6↔DAC(1)↔AOS 1	     ;SPACE DOWN 100 LINES.
	LAC[1B11+=192B23+=32]↔LACI 2,=864    ;864 ROWS OF 32 WORDS.
	DAC(1)↔ADDI 1,=33↔SOJG 2,.-2	  
	LAC[5770B11]↔DAC(1)↔AOS 1	     ;SPACE AFTER PICTURE.
	SLACI %↔DAC(1)			     ;CUT PAPER.

;PACK VIDEO BYTES INTO XGP 4 BY 4 BIT ARRAYS.
	LAC P1,[POINT 6,TVBUF,-1]
	LAC P2,XBUF↔ADDI P2,3		;BUFFER POINTER.
	LACI I,=216
L1:	LACI J,=32
L2:	SETZB 0,1↔SETZB 2,3↔LACI K,=9
L3:	ILDB Q,P1↔LSH Q,2
	CAIN J,=32↔GO[CAIN K,9↔IORI Q,4↔GO .+1]
	CAMN J,K↔GO[CAIN J,1↔LACI Q,4↔GO .+1]
	CAIE I,=216↔CAIN I,1↔IORI Q,8
	ROTC 0,4↔ROTC 2,4
	IOR 0,HTT+0(Q)↔IOR 1,HTT+1(Q)
	IOR 2,HTT+2(Q)↔IOR 3,HTT+3(Q)
	SOJG K,L3
	DAC 0,=00(P2)↔DAC 1,=33(P2)
	DAC 2,=66(P2)↔DAC 3,=99(P2)
	AOS P2↔SOJG J,L2
	ADDI P2,=100↔SOJG I,L1

;GRAB THE DEVICE.
L4:	INIT 1,17↔SIXBIT/XGP/↔0↔GO[OUTSTR[ASCIZ/XGP INIT FAILED.
/]↔	POP2J]↔SETZ↔SEGNUM↔DAC SAVSEG#↔DETSEG
	SLACI -=28516↔LAP XBUF↔SOS↔DAC DUMARG
	OUT 1,DUMARG↔RELEASE 1,↔LAC SAV44↔CORE
L5:	OUTSTR[ASCIZ/ XGP CORE UUO FAILED.
/]↔	CRLF↔LAC SAVSEG↔ATTSEG↔JFCL↔POP2J
;HALF TONE TABLE.
HTT:	0↔0↔0↔0↔	8↔8↔8↔8↔	17↔0↔0↔0↔	17↔8↔8↔8
DUMARG:0↔0
BEND VICXGP; BGB 6 MAY 1973 ---------------------------------------
SUBR(CREOUT)		OUTPUT CONTOURS, REGION, EDGE FILE.
BEGIN CREOUT;-----------------------------------------------------
	CALL(SHRINK)
	CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
	LACN FILM
	CALL(RELLOC,0)

;SETUP DUMP OUT ARGUMENT  IOWD.
	LAC FILM↔SUB@AVAIL
	LACM 1,0↔MOVSS
	LAP OLD44↔DAC OUTARG
	LAC@FILM↔DAC TMP#↔DAC 1,@FILM	;FILE SIZE IN WORDS.

;FILE OUTPUT RITUAL.
	LAC@AVAIL↔SUB FILM↔DAC@AVAIL
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	ENTER 1,FILNAM
	GO[OUTSTR[ASCIZ/	ENTER FAILED.
/]↔GO .+4]
	OUT 1,OUTARG↔JFCL
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,
	DZM FILNAM↔SETZ EXTION↔DZM EXTION+1↔DZM PPPN
	CALL(RELLOC,FILM)
	LAC TMP↔DAC@FILM
	LAC@AVAIL↔ADD FILM↔DAC@AVAIL
	POP0J
OUTARG:	0↔0
BEND CREOUT; BGB 6 DECEMBER 1972 ---------------------------------
SUBR(CREIN)	 CONTOUR,REGION,EDGE FILE FORMAT INPUT.
BEGIN CREIN;------------------------------------------------------

	CALL(GETFIL,[SIXBIT/CRE/],[0])↔POP0J
	INIT 1,17↔SIXBIT/DSK/↔0↔HALT
	LOOKUP 1,FILNAM↔GO[RELEASE 1,↔GO CREIN]

	DZM QBLK
	LAC PPPN↔LAP FILM↔SOS↔DAC INARG		;IOWD

	MOVS PPPN↔MOVMS↔ADD FILM
	IORI 1777↔CAMG 44↔GO L1
	CALLI 11↔HALT
	LAC 44↔AOS↔SUB FILM
	DIVI 7↔DAC 1,REMAINDER
L1:	IN 1,INARG
	OUTSTR[ASCIZ"	EOF.
"]↔	RELEASE 1,

	CDR@AVAIL↔ADD FILM↔DAC@AVAIL↔DZM@
	DIP↔AOS↔LAC 1,44↔BLT(1)		       ;CLEAR EMPTY AREA.
	CALL(RELLOC,FILM)

;RESET AVAIL LIST.
	LAC 1,@AVAIL↔LAC 2,44
	LIPI 1,NODSIZ(1)↔GO L6
L5:	HLRZM 1,(1)↔ADD 1,[XWD NODSIZ,NODSIZ]
L6:	CAILE 2,NODSIZ+NODSIZ-1(1)↔GO L5
	SUBI 2,NODSIZ-1(1)↔DAC 2,REMAINDER
	POP0J
INARG:	0↔0
BEND CREIN; BGB 28 JANUARY 1973 ----------------------------------
;TVIN4.		FOUR BIT TELEVISION INPUT.
SUBR(TVIN4)------------------------------------------------------
BEGIN TVIN4
	LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
	ADDI=6912↔CORE↔POP0J
L0:	INIT 17,17↔SIXBIT/TV/↔0
	GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
	DZM TVERR↔INPUT 17,TVPTR↔RELEASE 17,

;REPORT ON THE ERROR BITS AND RETAKE IF NECESSARY;
	LAC 1,TVERR
	TRNE 1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
/]↔	TRNE 1,000040↔OUTSTR[ASCIZ/TV DATA MISS.
/]↔	TRNE 1,000020↔OUTSTR[ASCIZ/TV NON EX MEM.
/]↔	TRNE 1,100060↔JRST L0
	TIMER↔DAC TVTIME#
	DATE↔DAC TVDATE#
	OUTSTR[ASCIZ/AKEN./]
	LAC[XWD HISTO,HISTO+1]		;CLEAR THE HISTOGRAM.
	DZM HISTO↔BLT HISTO+77

;CONVERT FROM GREY CODE TO GRAY CODE.
	LAC 16,[XWD L,0]↔BLT 16,12
	LAP TVPTR↔GO 4

L:	POINT 4,0,-1↔		FROM←←0
	POINT 6,TVBUF,-1↔	TO←←1
	=62208	↔		CNT←←2
	0	↔		BYT←←3
	ILDB BYT,FROM		;4
	LAC BYT,GRAY(BYT)	;3
	LSH BYT,2		;6
	AOS HISTO(BYT)		;7
	IDPB BYT,TO		;8
	SOJG CNT,4		;9
	GO .+1			;12
	LAC TMP44↔CORE↔HALT↔POP0J

BEND TVIN4; BGB 14 DECEMBER 1972 ---------------------------------

TVPTR:	XWD -=6912,0	↔ INTERN TVPTR
TVCLIP:	701002		;BCLIP=7 TCLIP=0 CAM=1.
INTERN TVCLIP
TVYXW:	BYTE(9)50,34,40
TVERR:	0
GRAY:	OCT 12,13,11,10,15,14,16,17,5,4,6,7,2,3,1,0
SUBR(TVIN6).		 SIX BIT TELEVISION INPUT.
BEGIN TVIN6;-----------------------------------------------------
	LAC 44↔DAC TMP44#↔AOS↔DAP TVPTR
	ADDI=6912*4↔CORE↔POP0J
L0:	INIT 17,17↔SIXBIT/TV/↔0
	GO[OUTSTR[ASCIZ"CAN'T INIT TV."]↔INCHRW↔GO .-3]
	DZM TVERR6#↔PUSH P,TVCLIP

	LACI 76↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 76.
	LAC TVPTR↔LIPI 440400↔DAC P1#
L1:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
	IORM TVERR6↔TRNE 100060↔GO L1

	LACI 54↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 54.
	LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P2#
L2:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
	IORM TVERR6↔TRNE 100060↔GO L2

	LACI 32↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 32.
	LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P3#
L3:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
	IORM TVERR6↔TRNE 100060↔GO L3

	LACI 10↔DPB[POINT 6,TVCLIP,23]		;TAKE CLIPS 10.
	LACI =6912↔ADDB TVPTR↔LIPI 440400↔DAC P4#
L4:	DZM TVERR↔INPUT 17,TVPTR↔LAC TVERR
	IORM TVERR6↔TRNE 100060↔GO L4
	POP P,TVCLIP↔RELEASE 17,

;REPORT ON THE ERROR BITS.
	LAC 1,TVERR6
	TRNE	1,100000↔OUTSTR[ASCIZ/TV PARITY ERROR.
/]↔	TRNE	1,40	↔OUTSTR[ASCIZ/TV DATA MISS.
/]↔	TRNE	1,20	↔OUTSTR[ASCIZ/TV NON EX MEM.
/]↔	TIMER↔DAC TVTIME#
	DATE↔DAC TVDATE#
	LAC[XWD HISTO,HISTO+1]↔DZM HISTO↔BLT HISTO+77
	OUTSTR[ASCIZ/AKEN./]
;CONVERT FROM GREY CODE TO GRAY CODE.
	LAC[POINT 6,TVBUF,-1]↔DAC P5#
	LAC[XWD L,3]↔BLT 16↔LACI =62208↔GO 3

;SIX BIT AC-LOOP.
L:	ILDB 1,P1↔LAC 2,GRAY(1)
	ILDB 1,P2↔ADD 2,GRAY(1)
	ILDB 1,P3↔ADD 2,GRAY(1)
	ILDB 1,P4↔ADD 2,GRAY(1)
	IDPB 2,P5↔AOS  HISTO(2)
	SOJG 0,3↔GO .+1
	LAC TMP44↔CORE↔HALT↔POP0J
BEND TVIN6; BGB 14 DECEMBER 1972 ---------------------------------
;REALIN - REAL NUMBER INPUT FROM TTY.
SUBR(REALIN)------------------------------------------------------
BEGIN REALIN
;AC-0 INTEGER ACCUMULATION.	AC-0 RETURNS REAL NUMBER.
;AC-1 CHARACTER.		AC-1 RETURNS BREAK CHARACTER.
;AC-2 COUNTER OF DIGITS TO RIGHT OF DECIMAL POINT PLUS ONE.
;AC-3 MINUS SIGN FLAG.
	SETZ↔SETZB 2,3
L1:	INCHWL 1
	CAIE 1,"-"↔GO .+3↔SETCMM 3↔GO L1
	CAIE 1,"."↔GO .+3↔JUMPN 2,L2↔AOJA 2,L1
	CAIL 1,"0"↔CAILE 1,"9"↔GO L2
	JUMPN 2,[CAILE 2,4↔GO L1↔AOJA 2,.+1]
	ANDI 1,17↔IMULI =10↔ADD 1↔GO L1
L2:	FLOAT↔SOSLE 2↔FDVR[1.0↔10.0↔100.0↔1000.0↔10000.0](2)
	SKIPE 3↔MOVNS↔POP0J
BEND REALIN; 16 DECEMBER 1972 ------------------------------------
END